home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / GEMDEBUG.V1 < prev    next >
Encoding:
Modula Implementation  |  1990-05-03  |  10.2 KB  |  388 lines
  1. IMPLEMENTATION MODULE Debug; (* V#048 *)
  2.  
  3. (* Erstellt Mai '87 von Thomas Tempelmann *)
  4.  
  5. (*
  6.  *   G E M - V e r s i o n
  7.  *  =======================
  8.  *
  9.  * Gibt Modula-Zeilen aus, die erzeugt werden, wenn im Quelltext die
  10.  * Compiler-Option "(*$D+*)" verwendet wird.
  11.  *
  12.  * Eine "Debug"-Ausgabeanweisung, die der Compiler erzeugt, hat folg. Format:
  13.  *
  14.  *   ... normaler Maschinencode ...
  15.  *   TRAP #5       -  Assembler-Anweisung, löst TRAP-5 Exception aus.
  16.  *   DC.W cmd      -  Kennung, die bestimmt, ob Zeile oder eine Zahl angezeigt
  17.  *                    werden soll (siehe unten, Funktion 'dispLine').
  18.  * [ ASC  '...' ]  -  Modula-Text, falls eine Zeile angezeigt werden soll;
  19.  *                    sonst steht die bestimmte Zahl auf dem Parameterstack.
  20.  *)
  21.  
  22. FROM SYSTEM IMPORT ADR, ADDRESS, ASSEMBLER, LONGWORD;
  23.  
  24. FROM Excepts IMPORT InstallExc, ExcDesc;
  25.  
  26. FROM PrgCtrl IMPORT TermProcess, CatchProcessTerm, TermCarrier;
  27.  
  28. FROM Strings IMPORT Length, Empty;
  29.  
  30. FROM MOSGlobals IMPORT UserBreak, MemArea;
  31.  
  32. FROM SysTypes IMPORT ExcSet, TRAP5;
  33.  
  34. FROM TextWindows IMPORT Read, Write, CondRead, ReadString, ForceMode,
  35.         FlushKbd, WQualitySet, WindowQuality, Window, ShowMode;
  36.  
  37. IMPORT TextWindows;
  38.  
  39. FROM ModCtrl IMPORT GetModName;
  40.  
  41. IMPORT StrConv;
  42.  
  43. TYPE Mode = (m2Line, asmLine, procEntry, procExit);
  44.  
  45. VAR WaitNext, WaitKey: BOOLEAN;
  46.  
  47.     io: Window;
  48.  
  49.  
  50. PROCEDURE WriteString (REF s:ARRAY OF CHAR);
  51.   BEGIN
  52.     TextWindows.WriteString (io,s)
  53.   END WriteString;
  54.  
  55. PROCEDURE WriteLn;
  56.   BEGIN
  57.     TextWindows.WriteLn (io)
  58.   END WriteLn;
  59.  
  60. PROCEDURE WriteLHex (v:LONGWORD);
  61.   BEGIN
  62.     WriteString (StrConv.LHexToStr (v,9))
  63.   END WriteLHex;
  64.  
  65. PROCEDURE dispRegs (VAR info: ExcDesc);
  66.   BEGIN
  67.     WriteLn;
  68.     WITH info DO
  69.       WriteString ('D0:');  WriteLHex (regD0);
  70.       WriteString (' D1:'); WriteLHex (regD1);
  71.       WriteString (' D2:'); WriteLHex (regD2);
  72.       WriteString (' D3:'); WriteLHex (regD3);
  73.       WriteLn;
  74.       WriteString ('D4:');  WriteLHex (regD4);
  75.       WriteString (' D5:'); WriteLHex (regD5);
  76.       WriteString (' D6:'); WriteLHex (regD6);
  77.       WriteString (' D7:'); WriteLHex (regD7);
  78.       WriteLn;
  79.       WriteString ('A0:');  WriteLHex (regA0);
  80.       WriteString (' A1:'); WriteLHex (regA1);
  81.       WriteString (' A2:'); WriteLHex (regA2);
  82.       WriteString (' A3:'); WriteLHex (regA3);
  83.       WriteLn;
  84.       WriteString ('A4:');  WriteLHex (regA4);
  85.       WriteString (' A5:'); WriteLHex (regA5);
  86.       WriteString (' A6:'); WriteLHex (regA6);
  87.       WriteString (' A7:'); WriteLHex (regUSP);
  88.     END
  89.   END dispRegs;
  90.  
  91.  
  92. PROCEDURE dispLine (mode: Mode; VAR info: ExcDesc);
  93.   
  94.   VAR buffered: BOOLEAN; bufCh: CHAR;
  95.   
  96.   PROCEDURE KeyPress():BOOLEAN;
  97.     BEGIN
  98.       CondRead (bufCh,buffered);
  99.       RETURN buffered
  100.     END KeyPress;
  101.   
  102.   PROCEDURE GetKey (VAR ch:CHAR);
  103.     BEGIN
  104.       IF buffered THEN
  105.         buffered:= FALSE;
  106.         ch:= bufCh
  107.       ELSE
  108.         TextWindows.BusyRead (ch)
  109.       END
  110.     END GetKey;
  111.   
  112.   VAR ch:CHAR; s:ARRAY [0..9] OF CHAR; p:CARDINAL; done,ok:BOOLEAN;
  113.       ps: POINTER TO ARRAY [0..160] OF CHAR;
  114.       proc,name: ARRAY [0..39] OF CHAR; rel: LONGCARD;
  115.   
  116.   BEGIN (* dispLine *)
  117.     IF WaitKey THEN
  118.       IF ~Continuous OR KeyPress() THEN
  119.         IF Active THEN TextWindows.Show (io) END;
  120.         REPEAT
  121.           GetKey (ch);
  122.           IF TextWindows.WasClosed (io) THEN
  123.             TextWindows.Hide (io);
  124.             Active:= FALSE
  125.           END;
  126.           ok:= TRUE;
  127.           CASE CAP (ch) OF
  128.             15C: Continuous:= TRUE|                             (* RETURN *)
  129.             ' ': Continuous:= FALSE|                            (* SPACE *)
  130.             3C : TermProcess (UserBreak)|                       (* CTRL-C *)
  131.             'A': Step:= 0L; Active:= TRUE; Continuous:= FALSE|
  132.             'S': WriteString ('Step? '); ReadString (io,s); p:=0;
  133.                  Step:= StrConv.StrToLCard (s,p,done);
  134.                  IF done THEN
  135.                    Active:= FALSE; Continuous:= TRUE; TextWindows.Hide (io);
  136.                  END|
  137.             'L': LineAddr:= ~LineAddr; ok:= FALSE|
  138.             'H': Hex:= TRUE; ok:= FALSE|
  139.             'D': Hex:= FALSE; ok:= FALSE|
  140.             'R': dispRegs (info); ok:= FALSE|
  141.           ELSE
  142.             ok:= FALSE
  143.           END
  144.         UNTIL ok
  145.       END
  146.     END;
  147.     
  148.     IF WaitNext THEN FlushKbd; WaitKey:= TRUE; WaitNext:= FALSE END;
  149.     
  150.     IF Active THEN Step:= 0L END;
  151.     
  152.     IF Step # 0L THEN
  153.       DEC (Step);
  154.       IF Step = 0L THEN Active:= TRUE; Continuous:= FALSE END;
  155.     END;
  156.     
  157.     ps:= info.regPC;                    (* PC hinter Zeilentext setzen *)
  158.     INC (info.regPC,Length (ps^)+1);
  159.     IF ODD (info.regPC) THEN INC (info.regPC) END;
  160.     
  161.     IF Active THEN                      (* Zeile anzeigen *)
  162.       WriteLn;
  163.       IF (mode = m2Line) OR (mode = asmLine) THEN
  164.         WriteLn;
  165.         IF LineAddr THEN
  166.           WriteLHex (info.regPC);
  167.           WriteString (': ');
  168.           GetModName (info.regPC,name,rel,proc);
  169.           WriteString (name);
  170.           WriteString (' / ');
  171.           IF ~Empty (proc) THEN
  172.             WriteString (proc)
  173.           ELSE
  174.             WriteString (StrConv.LHexToStr (rel,5))
  175.           END;
  176.           WriteLn;
  177.         END;
  178.         IF ps^[0]=12C (* LF *) THEN INC (ps) END;
  179.         WriteString (ps^);
  180.         WriteLn;
  181.       ELSE
  182.         IF mode = procEntry THEN
  183.           WriteString ('-> Enter ')
  184.         ELSE
  185.           WriteString ('<- Exit  ')
  186.         END;
  187.         WriteString (ps^);
  188.       END;
  189.     END;
  190.   END dispLine;
  191.  
  192. PROCEDURE dispLC (VAR info:ExcDesc; VarPar: BOOLEAN);
  193.   VAR p: POINTER TO LONGCARD;
  194.       q: POINTER TO ADDRESS;
  195.   BEGIN
  196.     IF VarPar THEN
  197.       q:= ADDRESS(info.regA3)-4L;
  198.       p:= q^
  199.     ELSE
  200.       p:= ADDRESS(info.regA3)-4L
  201.     END;
  202.     IF Hex THEN
  203.       WriteString (StrConv.LHexToStr (p^,0));
  204.     ELSE
  205.       WriteString (StrConv.CardToStr (p^,0));
  206.     END;
  207.     WriteString ('    ')
  208.   END dispLC;
  209.  
  210. PROCEDURE dispLI (VAR info:ExcDesc; VarPar: BOOLEAN);
  211.   VAR p: POINTER TO LONGINT;
  212.       q: POINTER TO ADDRESS;
  213.   BEGIN
  214.     IF VarPar THEN
  215.       q:= ADDRESS(info.regA3)-4L;
  216.       p:= q^
  217.     ELSE
  218.       p:= ADDRESS(info.regA3)-4L
  219.     END;
  220.     IF Hex THEN
  221.       WriteString (StrConv.LHexToStr (p^,0));
  222.     ELSE
  223.       WriteString (StrConv.IntToStr (p^,0));
  224.     END;
  225.     WriteString ('    ')
  226.   END dispLI;
  227.  
  228. PROCEDURE dispCard (VAR info:ExcDesc; VarPar: BOOLEAN);
  229.   VAR p: POINTER TO CARDINAL;
  230.       q: POINTER TO ADDRESS;
  231.   BEGIN
  232.     IF VarPar THEN
  233.       q:= ADDRESS(info.regA3)-4L;
  234.       p:= q^
  235.     ELSE
  236.       p:= ADDRESS(info.regA3)-2L
  237.     END;
  238.     IF Hex THEN
  239.       WriteString (StrConv.HexToStr (p^,0));
  240.     ELSE
  241.       WriteString (StrConv.CardToStr (p^,0));
  242.     END;
  243.     WriteString ('    ')
  244.   END dispCard;
  245.  
  246. PROCEDURE dispInt (VAR info:ExcDesc; VarPar: BOOLEAN);
  247.   VAR p: POINTER TO INTEGER;
  248.       q: POINTER TO ADDRESS;
  249.   BEGIN
  250.     IF VarPar THEN
  251.       q:= ADDRESS(info.regA3)-4L;
  252.       p:= q^
  253.     ELSE
  254.       p:= ADDRESS(info.regA3)-2L
  255.     END;
  256.     IF Hex THEN
  257.       WriteString (StrConv.HexToStr (p^,0));
  258.     ELSE
  259.       WriteString (StrConv.IntToStr (p^,0));
  260.     END;
  261.     WriteString ('    ')
  262.   END dispInt;
  263.  
  264. PROCEDURE dispChar (VAR info:ExcDesc; VarPar: BOOLEAN);
  265.   VAR p: POINTER TO CHAR;
  266.       q: POINTER TO ADDRESS;
  267.   BEGIN
  268.     IF VarPar THEN
  269.       q:= ADDRESS(info.regA3)-4L;
  270.       p:= q^
  271.     ELSE
  272.       p:= ADDRESS(info.regA3)-2L
  273.     END;
  274.     IF p^ < ' ' THEN          (* Steuerzeichen als Oktalkonstante anzeigen *)
  275.       WriteString (StrConv.NumToStr (ORD (p^),8,0,' '));
  276.       Write (io,'C')
  277.     ELSE
  278.       Write (io,p^)
  279.     END;
  280.     WriteString ('    ')
  281.   END dispChar;
  282.  
  283. PROCEDURE dispReal (VAR info:ExcDesc; VarPar: BOOLEAN);
  284.   VAR p: POINTER TO LONGREAL;
  285.       q: POINTER TO ADDRESS;
  286.   BEGIN
  287.     IF VarPar THEN
  288.       q:= ADDRESS(info.regA3)-4L;
  289.       p:= q^
  290.     ELSE
  291.       p:= ADDRESS(info.regA3)-8L
  292.     END;
  293.     WriteString (StrConv.RealToStr (p^,0,9));
  294.     WriteString ('    ')
  295.   END dispReal;
  296.  
  297. PROCEDURE dispBool (VAR info:ExcDesc; VarPar: BOOLEAN);
  298.   VAR p: POINTER TO BOOLEAN;
  299.       q: POINTER TO ADDRESS;
  300.   BEGIN
  301.     IF VarPar THEN
  302.       q:= ADDRESS(info.regA3)-4L;
  303.       p:= q^
  304.     ELSE
  305.       p:= ADDRESS(info.regA3)-2L
  306.     END;
  307.     IF p^ THEN
  308.       WriteString ('TRUE ')
  309.     ELSE
  310.       WriteString ('FALSE')
  311.     END;
  312.     WriteString ('    ')
  313.   END dispBool;
  314.  
  315.  
  316. PROCEDURE HdlExc ( VAR info: ExcDesc ): BOOLEAN;
  317.   VAR no:CARDINAL;
  318.   BEGIN
  319.     no:= CARDINAL (info.regPC^);
  320.     INC (info.regPC,2);
  321.     CASE no OF
  322.       0 : dispLine (m2Line, info)|
  323.       9 : dispLine (asmLine, info)|
  324.       20: dispLine (procEntry, info)|
  325.       21: dispLine (procExit, info)|
  326.     ELSE
  327.       IF Active THEN
  328.         CASE no OF
  329.            1 : dispLC (info, FALSE)|
  330.            2 : dispLI (info, FALSE)|
  331.            3 : dispChar (info, FALSE)|
  332.            4 : dispBool (info, FALSE)|
  333.            5 : dispReal (info, FALSE)|
  334.            6 : dispCard (info, FALSE)|
  335.            7 : dispInt (info, FALSE)|
  336.           11 : dispLC (info, TRUE)|
  337.           12 : dispLI (info, TRUE)|
  338.           13 : dispChar (info, TRUE)|
  339.           14 : dispBool (info, TRUE)|
  340.           15 : dispReal (info, TRUE)|
  341.           16 : dispCard (info, TRUE)|
  342.           17 : dispInt (info, TRUE)|
  343.         ELSE
  344.           DEC (info.regPC,2);
  345.           RETURN TRUE
  346.         END
  347.       END
  348.     END;
  349.     RETURN FALSE
  350.   END HdlExc;
  351.  
  352.  
  353. VAR stk: ARRAY [1..2000] OF CARDINAL;
  354.     wsp: MemArea;
  355.     hdl: ADDRESS;
  356.     tHdl: TermCarrier;
  357.     ok: BOOLEAN;
  358.  
  359. PROCEDURE Terminate;
  360.   VAR ch:CHAR;
  361.   BEGIN
  362.     TextWindows.Show (io);
  363.     WriteLn;
  364.     WriteString ('Programmende: Bitte Taste...');
  365.     Read (io,ch)
  366.   END Terminate;
  367.  
  368. BEGIN
  369.   Active:= TRUE;
  370.   Step:= 0L;
  371.   Continuous:= FALSE;
  372.   Hex := FALSE;
  373.   LineAddr:= FALSE;
  374.   
  375.   (* damit erste Zeile sofort erscheint: *)
  376.   WaitKey:= FALSE;
  377.   WaitNext:= TRUE;
  378.   
  379.   TextWindows.Open (io, 70,100, WQualitySet{movable,closable,dynamic,titled},
  380.                     hideWdw, forceLine, ' Debugger ', -1,-1,-1,-1, ok);
  381.   
  382.   wsp.bottom:= ADR (stk);
  383.   wsp.length:= SIZE (stk);
  384.   InstallExc ( ExcSet{TRAP5}, HdlExc, wsp, hdl );
  385.   IF hdl=NIL THEN HALT END;
  386.   CatchProcessTerm (tHdl,Terminate,wsp);
  387. END Debug.
  388.